home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / 第１特集Plug-in / Photoshop / Ster_ DropIns Folder.sit / Ster_ DropIns Folder / NIH-Image / Stereology…
Text File  |  1995-03-06  |  12KB  |  422 lines
  1. {Manual stereology macros for NIH Image.
  2.  
  3.  Overlay grids on an image with arrays of lines or points (reports
  4.  the number of points or the length of the lines in image units).
  5.  Grids provided include three different point arrays and four
  6.  line arrays, one of which is cycloids for vertical section method.
  7.  Then use paintbrush set to any of the fixed colors (up to 6)
  8.  to mark locations to be counted (e.g., where line grids cross
  9.  feature boundaries). Finally, use macro to count marks in each
  10.  class, and use results for stereological calculations.
  11.  
  12.  For more details, see the paper "Computer-Assisted Manual Stereology"
  13.  in Journal of Computer Assisted Microscopy, vol. 7 #1, p. 1, Mar. 1995
  14.  
  15.  ｩ 1995 John C. Russ - may be freely distributed if the documentation
  16.  is included.}
  17.  
  18. Macro 'Point Grid';
  19. Var
  20.    k,x,y,xoff,pwd,pht,nrow,ncol:integer;
  21.    area,ppx:real;
  22.       un:string;
  23. Begin
  24.    GetPicSize(pwd,pht);
  25.             NRow:=pht div 50;
  26.             NCol:=pwd div 50;
  27.             XOff:=(pwd - 50*NCol) div 2;
  28.             if XOff<25 THEN XOff:=25;
  29.             y:=(pht - 50*NRow) div 2;
  30.             if y<25 THEN y:=25;
  31.       Setlinewidth(1);
  32.             k:=0;
  33.             repeat {until >pht}
  34.                   x:= XOff;
  35.                   repeat {until >pwd}
  36.                            MoveTo (x-5, y);
  37.                            LineTo (x-1, y);
  38.                            MoveTo (x+1, y);
  39.                            LineTo (x+5, y);
  40.                            MoveTo (x, y-5);
  41.                            LineTo (x, y-1);
  42.                            MoveTo (x, y+1);
  43.                            LineTo (x, y+5);
  44.                            k:=k+1; {counter}
  45.                            x:=x+50;
  46.                   until ((x+10)>pwd);
  47.                   y:=y+50;
  48.             until ((y+20)>pht);
  49.    GetScale(ppx,un);
  50.             MoveTo (2,pht-6);
  51.    SetFont('Geneva');
  52.    SetFontSize(10);
  53.    Write('Total Points=',k:3);
  54.       Area:=pwd*pht/(ppx*ppx);
  55.       Moveto (2,pht-18);
  56.    Write('Total Area=',Area:10:3,'sq.',un);
  57. End;
  58.  
  59. Macro 'Staggered Grid';
  60. Var
  61.    i,k,x,y,xoff,yoff,pwd,pht,nrow,ncol:integer;
  62.    area,ppx:real;
  63.    un:string;
  64. Begin
  65.    GetPicSize(pwd,pht);
  66.             nrow:=pht div 34;
  67.             ncol:=pwd div 50;
  68.             XOff:=(pwd - 50*NCol) div 2;
  69.             if XOff<25 THEN XOff:=25;
  70.             YOff:=(pht - 34*NRow) div 2;
  71.             if yoff<25 THEN yoff:=25;
  72.       setlinewidth(1);
  73.             k:=0;
  74.             i:=0;
  75.             y:=yoff;
  76.             repeat {until >height}
  77.                   x:= XOff;
  78.                   IF (2*(i div 2)=i)
  79.                         THEN x:= x + 25;
  80.                   repeat {until >width}
  81.                            MoveTo (x-5, y);
  82.                            LineTo (x-2, y);
  83.                            MoveTo (x+2, y);
  84.                            LineTo (x+5, y);
  85.                            MoveTo (x, y-5);
  86.                            LineTo (x, y-2);
  87.                            MoveTo (x, y+2);
  88.                            LineTo (x, y+5);
  89.          MakeOvalRoi(x-2,y-2,5,5);
  90.          DrawBoundary;
  91.          KillRoi;
  92.                            k:=k+1; {counter}
  93.                            x:=x+50;
  94.                until ((x+25)>pwd);
  95.                y:=y+34;
  96.                i:=i+1;
  97.             until ((y+25)>pht);
  98.    GetScale(ppx,un);
  99.             MoveTo (2,pht-6);
  100.    SetFont('Geneva');
  101.    SetFontSize(10);
  102.    Write('Total Points=',k:3);
  103.       Area:=pwd*pht/(ppx*ppx);
  104.       Moveto (2,pht-18);
  105.    Write('Total Area=',Area:10:3,'sq.',un);
  106. END;
  107.  
  108. Macro 'Cycloids';
  109. Var
  110.    h,i,j,k,x,y,xoff,yoff,pwd,pht,nrow,ncol,xstep,ystep:integer;
  111.    len,area,ppx,pi,theta:real;
  112.    un:string;
  113. Begin
  114.       pi:=3.14159265;
  115.    GetPicSize(pwd,pht);
  116.             NRow:=pht div 90;
  117.             NCol:=pwd div 130;
  118.             XOff:=(pwd - 130*NCol) div 2;
  119.             YOff:=(pht - 90*NRow) div 2;
  120.    {cycloids are 110 wide x 70 high, length 140}
  121.    setlinewidth(1);
  122.       h:=0;
  123.             FOR j:=1 to NRow DO
  124.                   BEGIN
  125.                         y:=yoff + j*90-10;
  126.                         For i:=1 to ncol DO
  127.                               BEGIN
  128.                                     x:=xoff+(i-1)*130+10;
  129.                                     IF (h mod 4)=0 THEN
  130.                   BEGIN
  131.                                                 MoveTo (x,y);
  132.                                                 For k := 1 to 40 DO
  133.                                                       BEGIN
  134.                                                             theta:=(pi/40) *k;
  135.                                                             xstep:=round(35*(theta-sin(theta)));
  136.                                                             ystep:=round(35*(1.0-cos(theta)));
  137.                                                             Lineto (x+xstep,y-ystep);
  138.                                                       END;
  139.                   END;
  140.                      IF (h mod 4)=1 THEN
  141.                   BEGIN
  142.                                                 MoveTo (x,y-70);
  143.                                                 For k := 1 to 40 DO
  144.                                                    BEGIN
  145.                                                             theta:=(pi/40) *k;
  146.                                                             xstep:=round(35*(theta-sin(theta)));
  147.                                                                ystep:=round(35*(1.0-cos(theta)));
  148.                                                             Lineto (x+xstep,y-70+ystep);
  149.                                                       END;
  150.                   END;
  151.                                     IF (h mod 4)=2 THEN
  152.                   BEGIN
  153.                                                 MoveTo (x+110,y);
  154.                                                 For k := 1 to 40 DO
  155.                                                       BEGIN
  156.                                                             theta:=(pi/40) *k;
  157.                                                             xstep:=round(35*(theta-sin(theta)));
  158.                                                             ystep:=round(35*(1.0-cos(theta)));
  159.                                                             Lineto (x+110-xstep,y-ystep);
  160.                                                       END;
  161.                   END;
  162.                      IF (h mod 4)=3 THEN
  163.                   BEGIN
  164.                                                 MoveTo (x+110,y-70);
  165.                                                 For k := 1 to 40 DO
  166.                                                       BEGIN
  167.                                                             theta:=(pi/40) *k;
  168.                                                             xstep:=round(35*(theta-sin(theta)));
  169.                                                             ystep:=round(35*(1.0-cos(theta)));
  170.                                                             Lineto (x+110-xstep,y-70+ystep);
  171.                                                       END;
  172.                   END;
  173.                h:=h+1;
  174.                            END; {for i}
  175.                   END; {for j}
  176.    GetScale(ppx,un);
  177.    Len:=h*140/ppx;
  178.             MoveTo (2,pht-6);
  179.    SetFont('Geneva');
  180.    SetFontSize(10);
  181.    Write('Total Length=',Len:10:4,' ',un);
  182.       Area:=pwd*pht/(ppx*ppx);
  183.       Moveto (2,pht-18);
  184.    Write('Total Area=',Area:10:3,' sq.',un);
  185. END; 
  186.  
  187. Macro 'Square Lines';
  188. Var
  189.    i,j,x,y,xoff,yoff,pwd,pht,nrow,ncol:integer;
  190.    len,area,ppx:real;
  191.    un:string;
  192. Begin
  193.    GetPicSize(pwd,pht);
  194.             NRow:=pht div 100;
  195.             NCol:=pwd div 100;
  196.             XOff:=(pwd - 100*NCol) div 2;
  197.             YOff:=(pht - 100*NRow) div 2;
  198.             if XOff=0 THEN
  199.                   BEGIN
  200.                         XOffset:=50;
  201.                         ncol:=ncol-1;
  202.                   END;
  203.             if yoff=0 THEN
  204.                   BEGIN
  205.                         yoff:=50;
  206.                         nrow:=nrow-1;
  207.                   END;
  208.    setlinewidth(1);
  209.             For j:=0 to NRow DO
  210.                   BEGIN
  211.                         y:= YOff + j*100;
  212.                         MoveTo (xoff, y);
  213.                         LineTo (pwd-xoff-1, y);
  214.                   END;
  215.             For i:=0 to ncol DO
  216.                   BEGIN
  217.                         x:= XOff + i*100;
  218.                         MoveTo (x,YOff);
  219.                         LineTo (x,pht-YOff-1);
  220.                   END;
  221.    GetScale(ppx,un);
  222.    Len:=(NRow*(Ncol+1)+NCol*(Nrow+1))*100/ppx;
  223.             MoveTo (2,pht-6);
  224.    SetFont('Geneva');
  225.    SetFontSize(10);
  226.    Write('Total Length=',Len:10:4,' ',un);
  227.       Area:=pwd*pht/(ppx*ppx);
  228.       Moveto (2,pht-18);
  229.    Write('Total Area=',Area:10:3,' sq.',un);
  230. END;
  231.  
  232. Macro 'Circle Grid';
  233. var
  234.    i,j,x,y,xoff,yoff,pwd,pht,nrow,ncol:integer;
  235.    len,area,ppx,pi:real;
  236.    un:string;
  237. begin
  238.    GetPicSize(pwd,pht);
  239.    setlinewidth(1);
  240.       pi:=3.14159265;
  241.             NRow:=pht div 120;
  242.             NCol:=pwd div 120;
  243.             XOff:=(pwd - 130*ncol) div 2;
  244.             YOff:=(pht - 130*NRow) div 2;
  245.             For j:=1 to NRow DO
  246.                   BEGIN
  247.                         y:= YOff + 15 + (j-1)*130;
  248.                         For i:=1 to NCol DO
  249.                               BEGIN
  250.                                     x:= XOff + 15 + (i-1)*130;
  251.                MakeOvalRoi(x,y,101,101);
  252.                DrawBoundary;
  253.                KillRoi;
  254.                               END;
  255.       END;
  256.    GetScale(ppx,un);
  257.    Len:=NRow*NCol*pi*100/ppx;
  258.             MoveTo (2,pht-6);
  259.    SetFont('Geneva');
  260.    SetFontSize(10);
  261.    Write('Total Length=',Len:10:4,' ',un);
  262.       Area:=pwd*pht/(ppx*ppx);
  263.       Moveto (2,pht-18);
  264.    Write('Total Area=',Area:10:3,' sq.',un);
  265. END;
  266.  
  267. Macro '(-';
  268. BEGIN END;
  269.  
  270.  
  271. Macro 'Random Points';
  272. Var
  273.       x,y,k,i,pwd,pht,limt:integer;
  274.    ppx,area:real;
  275.    un:string;
  276.    collide:boolean;
  277. Begin
  278.             GetPicSize(pwd,pht);
  279.    limt:=50;{number of points}
  280.    k:=1;
  281.             repeat
  282.                         x:=random*(pwd-20); {10 pixel margin around borders}
  283.       y:=random*(pht-20);
  284.       collide:=false;
  285.       if k>1 then {avoid existing marks}
  286.                                     for i:=1 to k-1 do
  287.             if (Abs(x-rUser1[i])<5) and (Abs(y-rUser2[i])<5)
  288.                then collide:=true;
  289.       if not collide then
  290.                                     begin
  291.             rUser1[k]:=x;
  292.             rUser2[k]:=y;
  293.             MakeOvalRoi(x+6,y+6,7,7);
  294.             DrawBoundary;
  295.             KillRoi;
  296.             k:=k+1;
  297.          end;
  298.    until (k>limt);
  299.    GetScale(ppx,un);
  300.       Area:=pwd*pht/(ppx*ppx);
  301.    SetFont('Geneva');
  302.    SetFontSize(10);
  303.       Moveto (2,pht-18);
  304.    Write('Total Area=',Area:10:3,'sq.',un);
  305.             Moveto (2,pht-6);
  306.    Write('Total Points=',k-1:4);
  307. End;
  308.     
  309. Macro 'Random Lines';
  310. Var
  311.    x,y,theta,m,area,ppx,dummy:real;
  312.    i,j,k,x1,x2,y1,y2,pwd,pht:integer;
  313.    len,limt:integer;
  314.    un:string;
  315. Begin
  316.             GetPicSize(pwd,pht);
  317.             len:=0;
  318.             k:=0;
  319.             limt:=3*(pwd+pht); {minimum total length in pixels}
  320.             repeat {until length>limt}
  321.                         x:=random*pwd;
  322.       y:=random*pht;
  323.       theta:=random*3.14159265;
  324.       m:=sin(theta)/cos(theta);
  325.       x1:=0;
  326.       y1:=y+m*(x1-x);
  327.       if y1<0 then
  328.                           begin
  329.                y1:=0;
  330.             x1:=x+(y1-y)/m;
  331.          end;
  332.       if y1>pht then
  333.          begin
  334.             y1:=pht;
  335.             x1:=x+(y1-y)/m;
  336.          end;
  337.       x2:=pwd;
  338.       y2:=y+m*(x2-x);
  339.       if y2<0 then
  340.                           begin
  341.                y2:=0;
  342.             x2:=x+(y2-y)/m;
  343.          end;
  344.       if y2>pht then
  345.          begin
  346.             y2:=pht;
  347.             x2:=x+(y2-y)/m;
  348.          end;
  349.       moveto(x1,y1);
  350.       lineto(x2,y2);
  351.       len:=len+sqrt((x2-x1)*(x2-x1)+(y1-y2)*(y1-y2))
  352.       k:=k+1;
  353.    until len>limt;
  354.    GetScale(ppx,un);
  355.       Area:=pwd*pht/(ppx*ppx);
  356.    SetFont('Geneva');
  357.    SetFontSize(10);
  358.       Moveto (2,pht-18);
  359.    Write('Total Area=',Area:10:3,'sq.',un);
  360.    Len:=Len/ppx;
  361.             Moveto (2,pht-6);
  362.    Write('Total Length=',Len:10:3,' ',un);
  363. END;
  364.  
  365. Macro '(-';
  366. BEGIN END;
  367.  
  368. Macro 'Count Marks'; {note - this routine is VERY slow because it must
  369. access each pixel. The Photoshop drop-in is much faster for counting
  370. features, and when used by NIH Image will perform exactly as this does
  371. and count the number of marks in each of the six reserved colors.}
  372. VAR
  373.       i,j,k,pwd,pht,valu,nbr,newfeat : integer;
  374. BEGIN
  375.    GetPicSize(pwd,pht);
  376.       For i:= 1 to 6 DO
  377.             BEGIN
  378.                rUser1[i]:=0;
  379.       END;
  380.    MoveTo(0,0);
  381.       FOR i:=1 to pht DO
  382.             BEGIN
  383.          GetRow(0,i,pwd);
  384.                   newfeat:=0; {start of a new image line - nothing pending}
  385.                   for j:=1 to pwd-1 DO {skip edge pixels}
  386.                         BEGIN
  387.                               valu:=Linebuffer[j]; {test pixel}
  388.                               if ((valu=0) or (valu>6)) THEN
  389.                                     BEGIN {pixel is not a fixed color}
  390.                                           if (newfeat>0) then {End of a line}
  391.                                                 BEGIN
  392.                                                       rUser1[newfeat]:=rUser1[newfeat]+1;
  393.                                                 END;
  394.                                           newfeat:=0;
  395.                                     END;
  396.                               if ((valu>=1) and (valu<=6)) then {a fixed color point}
  397.                                     BEGIN
  398.                                           nbr:=LineBuffer[j-1]; {left side}
  399.                                           if (nbr<>valu) THEN {test continuation of line}
  400.                                                 BEGIN
  401.                                                       if newfeat>0 then {prev touching color}
  402.                                                             BEGIN
  403.                                                                   rUser1[newfeat]:=rUser1[newfeat]+1;
  404.                                                             END;
  405.                                                       newfeat:=valu;{start of a chord}
  406.                                                 END; 
  407.                                           for k:=j-1 to j+1 DO {check prev line}
  408.                                                 BEGIN
  409.                                                       nbr := GetPixel(k,i-1);
  410.                                                       if (nbr = valu) then
  411.                                                             BEGIN
  412.                                                                   newfeat:=0;{touches}
  413.                                                             END;
  414.                                                 END;
  415.                                     END;
  416.                      END; {for j}
  417.                      LineTo(0,i); {progress indicator because getpixel is very slow}
  418.             END; {for i}
  419.    Showmessage('Class#1=',rUser1[1]:3,'¥Class#2=',rUser1[2]:3,'¥Class#3=',rUser1[3]:3,
  420.         '¥Class#4=',rUser1[4]:3,'¥Class#5=',rUser1[5]:3,'¥Class#6=',rUser1[6]:3);
  421.    {can substitute other output procedures as needed}
  422. END;